Cream of the Crop 3/Cream of the Crop 3.iso/comm/prtcs155.zip/SHELTER.REX

OS/2 REXX Batch file | 1994-01-14 | 36KB | 1,142 lines

/*  Shelter WPL Mailers Manager    Williamson */
/* OPTIONS */
do_outs=0   /* if 1, flocvt will queue .OUT files */
/**/
options results
options failat 99
signal on syntax
signal on halt
signal on ioerr
signal on break_c
signal on break_d

if ~show('L', "rexxsupport.library") then
    if ~addlib("rexxsupport.library", 0, -30, 0) then do
        say "Couldn't access rexxsupport.library !"
        exit 20
    end
if ~show('L', "RexxDosSupport.library") then
    if ~addlib("RexxDosSupport.library", 2, -30, 0) then do
        say "Couldn't access RexxDosSupport.library !"
        exit 20
    end
if ~show('L', "hGRexxSupport.library") then
    if ~addlib("hGRexxSupport.library", 2, -30, 0) then do
        say "Couldn't access hGRexxSupport.library !"
        exit 20
    end
if (left(ReadVar('KickStart',"R"),2)) < 37 then do
    say 'Sorry, AmigaDOS Release 2 or higher is required to use Shelter'
    exit 20
end
if ~show("L", "xferq.library") then
    if ~addlib("xferq.library", 0, -30, 0) then do
        say "Couldn't access xferq.library !"
        exit 20
    end
pragma("W","NULL")
Address COMMAND "CD MAIL:"
if RC~=0 then do
    say 'Where is MAIL:?'
    exit 40
end
wpath='CFG:WPL/'
log=show('P',"ROOFLOG")
wfhost=ReadVar('WFHOST')=="TRUE"
pktpri=55
CLS='0C'x; CSI='9b'x;OFF=CSI||'0m';BOLD=CSI||'1m';ULINE=CSI||'4m';ITALICS=CSI||'3;40m'

/* get Shelter Mailer Name */
smver=ReadVar('SMVER',"R")
shelter=ReadVar("SHELTER","R")
if shelter="" | shelter = "SHELTER" then do
    Say "No Shelter Mailer available"
    u_shelter="*** NO SHELTER ***"
    signal usage
end
call setup(shelter)
XQ_NOTHING=0;XQ_DELETE=1;XQ_TRUNCATE=2;XQ_IMMEDIATE=4;XQ_SENDLATER=8
DTPRI_HXT=60;DTPRI_CRASH=50;DTPRI_DIRECT=30;DTPRI_NORM=0;DTPRI_HOLD=-50

fontsize=8;havewin=0;DoUnLoad=0
PARSE UPPER ARG WHAT WHERE HOW
    if WHAT="" | WHAT="?" then signal usage
Select
    when WHAT="INIT" then do
        call GetVariables
    end
    when WHAT="CALL" then do
        if WHERE="" then signal callusage
        call dial(WHERE,HOW)
    end
    when WHAT="RESTART" then do
        call openwin("P")
        call closemailer(WHAT)
        call closelogs
        options prompt "Generate? (y/N) "
        parse pull ans
        if upper(ans)="Y" then do
            Address REXX GetClip('REXXDIR')'/GenMailer.rexx' u_shelter 'ALL'
            if RC~=0 then exit RC
        end
        call GetVariables()
        if ~DoUnLoad then call raisemailer()
        say "Command: "what" completed"
    end
    when what="AUTO" then do
        call GetVariables()
        call openpscr()
        call openwin("P")
        call loadlogproc()
        call raisemailer()
        call flocvt
        boss_site=GetClip("BOSS")
        parse var boss_site System number
        call dial(System,number,"S")
        if u_shelter="UMBRELLA" then do
            call closemailer(WHAT)
            call closelogs
            call closepscr
        end
    end
    when what="AUTOX" then do
        call GetVariables()
        call openpscr()
        call openwin("P")
        call loadlogproc()
        call raisemailer()
        boss_site=GetClip("BOSS")
        parse var boss_site System number
        call dial(System,number,"S")
        if u_shelter="UMBRELLA" then do
            call closemailer(WHAT)
            call closelogs
            call closepscr
        end
    end
    when WHAT="KILL" then do
        if WHERE="" then signal callusage
        call openwin("S")
        call killdial(WHERE)
    end
    when WHAT="OPENSTATUS" then call openstatus(WHERE)
    when WHAT="CLOSESTATUS" then call closestatus(WHERE)
    when WHAT="EXIT" then do
        call openwin("S")
        call closemailer(WHAT)
        call closelogs
        call closepscr
    end
    when WHAT="FLOCVT" then do
        call openwin("S")
        call flocvt()
        say "Command: "what" completed"
    end
    when WHAT="ADDWORK" then do
        call openwin("P")
        call addwork(WHERE,HOW)
        say "Command: "what" completed"
    end
    when WHAT="POLL" then do
        call openwin("S")
        call dopolls(WHERE)
        say "Command: "what" completed"
    end
    when WHAT="CLEAN" then do
        call openwin("P")
        call cleanxq()
        say "Command: "what" completed"
    end
    when WHAT="START" then do
        if WHERE ~="" & WHERE ~="WHERE" then call setup(WHERE)
        call GetVariables()
        call openpscr()
        call openwin("P")
        call loadlogproc()
        call raisemailer()
        call addwork("BADPASSWORD","CFG:PASSWORD.BAD L 75")
        if exists(rexxdir||'Sctl.rexx') then address AREXX rexxdir||'Sctl.rexx'
        say "Command: "what" completed"
    end
    otherwise Say 'Unknown command:'what
end /*select*/
/*
if havewin=1 then do
    call close('STDIN')
    call close('STDOUT')
end
*/
exit 0

loadlogproc:
    if ~showlist('p','LOGPROC') then do
        Address COMMAND "run >nil: logproc"
        say "Waiting for LogProc Port"
        Address COMMAND "waitforport LOGPROC"
        say "Log port ready"
    end
    if ~showlist('p','LOGPROC') then do
        say "Unabled to access LOGPROC"
        exit 10
    end
return

raisemailer:
    logfile=GetClip('LOGFILE')
    if logfile="" then logfile="MAIL:Shelter.LOG"
    Say  "Opening "logfile
    Address "LOGPROC"
    'OpenLog' file 'f' logfile

    logwindow=GetClip('LOGWINDOW')
    if index(logwindow,":")=0 then 'AddLogGroup' fgroup file
    else do
        logwindow=logwindow||"/SCREEN"||GetClip('SCREEN')
        Say  "Opening "logwindow
        'OpenLog' fwindow 'w' logwindow
        'AddLogGroup' fgroup file fwindow
    end
    Address
    slave=0
    PutLog('Opened log 'logfile date())

    slave=1
    if show('P',mport||slave) then do
        say mport||slave 'already active'
        exit 10
    end
    if ~show('p',"sushi_CAS_port") then do
        PutLog('Loading Sushi')
        address COMMAND "Run Sushi <>NULL: ON NOPROMPT ASKSAVE"
        call SetCLip('MYSUSHI',"TRUE")
    end

    PutLog('Loading 'u_shelter' Mailer')
    pcmd="ChangeTaskPri 1"||'0a'x
    scmd="Stack 50000"||'0a'x

    do i=1 to wscount
        parse var wsrc.i wscript.i '.' x
        lcmd='LoadScript' lower(wscript.i) wpath||wsrc.i
        cmd=scmd||pcmd||lcmd
        address COMMAND cmd
        stat=RC
        if stat ~=0 then do
            PutLog(lcmd 'returned' stat', did you note the error or forget to generate the Mailer?')
            DoUnLoad=1;signal unloadscripts
            exit
        end
    end
    PutLog('Launching 'u_shelter'0')
    cmd=scmd||pcmd||'Launch 'u_shelter'0 'l_shelter'!startup 0 30000'
    address COMMAND cmd
    stat=RC
    if stat ~=0 then PutLog(cmd 'returned' stat)
return 0

closemailer:
    call putlog('Closing slaves')
    if u_shelter~="UMBRELLA" then ports=GetClip('SLAVES')
    else ports=1
    do i=ports to 1 by -1
        if show('p',mport||i) then do
            call PutLog('Closing:'mport||i)
            address VALUE mport||i
            'Set exit 'arg(1)
            call delay(10)
            'ABORT'
            do while show('p',mport||i)
                call delay(10)
            end
        end
        call delay(100)
    end
unloadscripts:
    call putlog('Flushing mailer')
    do i=1 to wscount
        parse var wsrc.i wscript.i '.' x
        ulcmd='LoadScript' lower(wscript.i) '""'
        address COMMAND ulcmd
        stat=RC
        if stat~=0 then call PutLog(ulcmd 'returned' stat)
        call closestatus(i)
    end
    if show('P','sushi_CAS_port') then do
        if GetCLip('MYSUSHI')="TRUE" then do
            call PutLog("Closing Sushi")
            address COMMAND "sushi OFF"
        end
    end
return 0

closelogs:
    call putlog('Closing logs')
    address "LOGPROC"
    'Closelog 'file
    logwindow=GetClip('LOGWINDOW')
    if index(logwindow,":") > 0 then 'CloseLog' fwindow
    'RemLogGroup 'fgroup
return

closestatus:
slave=arg(1)
if u_shelter="UMBRELLA" then slave=1
address "LOGPROC"
'Closelog 'window||slave
'RemLogGroup' wgroup||slave
Address
return 0

openstatus:
if u_shelter="UMBRELLA" then slave=1
    else slave=arg(1)
if ~show('P',mport||slave) then do
    PutLog(mport||slave 'not active')
    exit 10
end
rws.specs=GetClip('WSPEC')
if rws.specs="" then rws.specs="NOSIZE/NODEPTH/INACTIVE"
rws.x=0 ; rws.y=10 ; rws.chars=80 ; rws.lines=7 ; rws.text='@f3@R'
rws.0='   Status'copies(" ",53)'H_Freqs'copies(" ",10)
rws.1=' Response'copies(" ",13)'Login'copies(" ",35)'R_Freqs'copies(" ",10)
rws.2='     Baud'copies(" ",13)'H_Adr'copies(" ",35)'Inbound'copies(" ",10)
rws.3='   Number'copies(" ",13)'R_Adr'copies(" ",35)'Domain'copies(" ",10)
rws.4=' Password'copies(" ",13)'Sysop'copies(" ",52)
rws.5='  Session'copies(" ",13)'H_Ofr'copies(" ",52)
rws.6=' Protocol'copies(" ",13)'R_Ofr'copies(" ",52)
p.1="p.status   @1,10,53 @R"
p.2="p.response @2,10,13 @R"
p.3="p.baud     @3,10,13 @R"
p.4="p.number   @4,10,13 @R"
p.5="p.password @5,10,13 @R"
p.6="p.session  @6,10,13 @R"
p.7="p.protocol @7,10,13 @R"
p.8="p.login   @2,28,35 @R"
p.9="p.host    @3,28,35 @R"
p.10="p.remote  @4,28,35 @R"
p.11="p.rsysop   @5,28,52 @R"
p.12="p.hoffer   @6,28,52 @R"
p.13="p.roffer   @7,28,52 @R"
p.14="p.hfreqs   @1,70,10 @R"
p.15="p.rfreqs   @2,70,10 @R"
p.16="p.inbound  @3,70,10 @R"
p.17="p.domain   @4,70,10 @R"
positions=17

if u_shelter~="UMBRELLA" then do
    slavewindows=getwindows()
    if slavewindows~=0 then rws.y=rws.y+(w_height(rws.lines)*slavewindows)
end
Address VALUE mport||slave
'String $(device) $(unit) $(modem)'
minfo=mport||slave strip(RESULT)
xspec='RAW:'rws.x'/'rws.y'/'w_width(rws.chars)'/'w_height(rws.lines)'/The 'u_shelter' Mailer v'smver' 'minfo'/'rws.specs'/SCREEN'GetClip('SCREEN')
address "LOGPROC"
'OpenLog' window||slave "'w'" xspec
'AddLogGroup' wgroup||slave window||slave
do i=0 to rws.lines
    'PutLine' wgroup||slave  '@'i+1',1' rws.text||rws.i||copies(" ",rws.chars-length(rws.i))
end

Address VALUE mport||slave
do i=1 to positions
    'Set' word(p.i,1) '"'subword(p.i,2)'"'
end
Address
return 0

getwindows: procedure expose l_shelter
    slavewindows=0
    Address LOGPROC 'Show "l"'
    logs=RESULT
    if words(logs)=0 & slave > 1 then return slave-1
    if words(logs)=0 then return 0
    do i=1 to words(logs)
        if index(word(logs,i),l_shelter'ss') > 0 then slavewindows=slavewindows+1
    end
return slavewindows

dial:
System=arg(1)
Number=arg(2)
lmode=arg(3)
if Number="NUMBER" then Number=""
else number="NUMBER "Number
if u_shelter="ROOF" then address COMMAND "RUN >NIL: CALL" System Number
else do
    if lmode="S" then Address "REXX" GetClip('REXXDIR')"/Scall" System Number
    else Address "AREXX" GetClip('REXXDIR')"/Scall" System Number
end
return

killdial:
if ~datatype(arg(1),'MIXED') then site_address=make5d(arg(1))
else site_address=arg(1)
call SetClip("S"||site_address,'abort')
PutLog('Call to 'site_address' will be aborted on next attempt')
return

callcleanup:
call PutLog('Removing 'site_address' from dial queue')
call SetClip("S"||site_address,"")
return 0

make5d: procedure expose dd z n f p
da=arg(1)
select
    when index(da, "#") > 0 then parse var da dd "#" z ":" n "/" f "." p
    when index(da, ":") > 0 then parse var da z ":" n "/" f "." p
    when index(da, "/") > 0 then parse var da n "/" f "." p
    when index(da, ".") > 0 then parse var da f "." p
    when left(da, 1)="." then parse var da "." p
    otherwise parse var da f .
end
myaddress.domain=GetClip('DOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point

if p="" | p='P' then p='0'
if n="" | n='N' then n=myaddress.net
if f="" | f='F' then f=myaddress.node
if z="" | z='Z' then z=myaddress.zone
if dd="" | dd='DD' then do
    dl=GetClip('DOMAINLIST')
    dd=0
    x=find(dl,z)
    if x~=0 then dd=word(dl,x-1)
    if dd=0 then dd=myaddress.domain
end

if ~datatype(z,'n') | ~datatype(n,'n') | ~datatype(f,'n') | ~datatype(p,'n') then do
    call PutLog('make5d: Invalid address ['da']')
    return 0
end
drop da
if myaddress.domain"#"cfgaddress=dd'#'z':'n'/'f'.'p
then p=0
return(dd'#'z':'n'/'f'.'p)

flocvt:
outdir=addslash(dequote(GetClip('OUTDIR')))
flodir=addslash(dequote(GetClip('FLODIR')))
call PutLog('Searching for FLO files in' flodir)
Address COMMAND 'LIST >t:flofilelist 'flodir||'#?.#?.#?.#?.?LO quick nohead'
if word(statef("T:flofilelist"),2)=0 then do
    call PutLog('No ?LO files in' outdir)
    Signal scanout
end

if ~open('flolist',"t:flofilelist",'R') then do
    call PutLog("Error opening 4D .FLO list")
    return 10
end
i=0
do forever
    Line=Upper(strip(space(ReadLn('flolist'),1),'B'))
    if EOF('flolist') then Leave
    if Line="" then iterate
    i=i+1
    node.i=Line
    parse var Line flonode.i.zone "." flonode.i.net "." flonode.i.node "." flonode.i.point "." junk
    flonode.i.domain=find_domain(flonode.i.zone)
    flonode.i.pri="0"

    floadr=flonode.i.zone":"flonode.i.net"/"flonode.i.node"."flonode.i.point
    if Left(junk,1)="C" then flonode.i.pri=DTPRI_CRASH
    if Left(junk,1)="H" then flonode.i.pri=DTPRI_HOLD
    if Left(junk,1)="D" then flonode.i.pri=DTPRI_DIRECT
    if Left(junk,1)="N" then flonode.i.pri=DTPRI_NORM
    if Left(junk,1)="F" then flonode.i.pri=DTPRI_NORM
end
call close('flolist')
if i=0 then do
    call PutLog("Error: No 4D ?LO Files found in" flodir)
    drop flonode floadr
    call delete("T:flofilelist")
    return 0
end
flonode.numnodes=i
do anode=1 until anode=flonode.numnodes
    drop flags
    floadr=flonode.anode.zone':'flonode.anode.net'/'flonode.anode.node'.'flonode.anode.point
    call PutLog("Converting" node.anode "for" floadr)
    jnode=left(node.anode,length(node.anode)-3)
    floname=upper(flodir||jnode||Left(right(node.anode,3),1)||"LO")
    call PutLog("floname:"floname)

    flonode.anode.domain=find_domain(flonode.anode.zone)

    site=flonode.anode.domain||"#"||flonode.anode.zone||":" ,
        ||flonode.anode.net||"/"||flonode.anode.node||"."||flonode.anode.point
    PutLog('Site:'site,10,10)
    if u_shelter="ROOF" then myaddress.domain=GetClip('DOMAIN')
    else myaddress.domain=GetClip('FTNDOMAIN')
    cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
    parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point

    err=0
    if ~exists(floname) then do
        call PutLog("Error: Can't find "floname)
        call drop_vars
        err=1
    end
    else if ~Open('flofile',floname,'R') then do
        call PutLog("Error: Can't open" floname)
        call drop_vars
        err=1
    end

    site_address=XfqGetAddress(site)
    if ~err then do
        do forever
            Line=upper(ReadLn('flofile'))
            if eof('flofile') then Leave
            if Line="" then Iterate

            flags=XQ_NOTHING
            if (LEFT(Line,1)="#") then do
                flags=XQ_TRUNCATE
                Line=DELSTR(Line,1,1)
            end;else if (LEFT(Line,1)="^") | (LEFT(Line,1)="-") then do
                flags=XQ_DELETE
                Line=DELSTR(Line,1,1)
            end;else if (LEFT(Line,1)="@") then do
                flags=XQ_NOTHING
                Line=DELSTR(Line,1,1)
            end
            if ~exists(Line) then do
                call PutLog("File "Line" No Longer Exists")
                Iterate
            end

            if right(Line,4) = ".TIC" then do
                flags=XQ_DELETE
                sendas=get_fn(Line)
            end;else if right(Line,2)="UT" then do
                Line=move_out(Line)
                sendas=get_packetname()
                if Left(right(Line,3),1)="C" then t.pri=DTPRI_HXT
                if Left(right(Line,3),1)="H" then t.pri=DTPRI_HOLD
                if Left(right(Line,3),1)="D" then t.pri=DTPRI_DIRECT
                if Left(right(Line,3),1)="N" then t.pri=DTPRI_NORM
                if Left(right(Line,3),1)="F" then t.pri=flonode.anode.pri
            end;else do
                parse var Line x '.' x '.' x '.' x '.' ext
                if ext="" then do
                    sendas=get_fn(Line)
                    flags=XQ_NOTHING
                    t.pri=flonode.anode.pri
                end;else do
                    tmpext=upper(left(ext,2))
                    if datatype(right(ext,1),'n') & (tmpext="MO" | tmpext="TU" | tmpext="WE" | tmpext="TH" | tmpext="FR" | tmpext="SA" | tmpext="SU")  then do
                        sendas=UPPER(d2x(65536+myaddress.net-flonode.anode.net,4)||d2x(65536+myaddress.node-flonode.anode.node,4)||'.'ext)
                        flags=XQ_DELETE
                        t.pri=flonode.anode.pri
                    end
                end
                drop ext x
            end
            call PutLog(Line' as 'sendas' for:'floadr' Disp:'flags' Pri:'t.pri)
            QUERY.XQ_NAME=line
            QUERY.XQ_SITE=site_address
            work=NULL
            work=XfqFindWork(QUERY)
            if work=NULL then do
                call PutLog("File "line" not in "site" queue, adding as "sendas)
                XfqAddWorkQuick(site,Line,sendas,t.pri,flags)
            end;else do
                call PutLog("File "line" re-queued")
                call XfqUnlockWork(work)
/*                call XfqDropObject(work)  */
            end
        end /*forever*/
    end /* flofile */
    call close('flofile')
    call delete(floname)
    call XfqFlushQueue(site_address)
    call XfqDropObject(site_address)
    if work~=NULL then call XfqDropObject(work)
end
call XfqClose()
call drop_vars
call delete("T:flofilelist")
scanout:
call PutLog('Searching for .?UT files in' outdir)
Address COMMAND 'LIST >t:outlist 'outdir||'#?.#?.#?.#?.?UT quick nohead'
if word(statef("T:outlist"),2)=0 then do
    call PutLog('No ?UT files in' outdir)
    Return
end
if ~open('outs',"t:outlist",'R') then do
    call PutLog("Error opening 4D .?UT list")
    return 10
end
do while ~eof('outs')
    outfile=upper(readln('outs'))
    if outfile="" then iterate
    parse var outfile oz '.' on '.' of '.' op '.' ext
    if ~do_outs & ext="OUT" then do
        PutLog('Skipping 'outfile)
        Iterate
    end
    xtype=left(ext,1)
    if xtype="C" then flonode.i.pri=DTPRI_HXT
    else if xtype="H" then flonode.i.pri=DTPRI_HOLD
    else if xtype="D" then flonode.i.pri=DTPRI_DIRECT
    else if xtype="N" then flonode.i.pri=DTPRI_NORM
    else if xtype="O" then flonode.i.pri=DTPRI_NORM
    else do
        call PutLog('ERROR: cannot queue 'outfile)
        Iterate
    end
    drop xtype
    call addwork(oz':'on'/'of'.'op,outdir||outfile "D" flonode.i.pri)
end
call delete("T:outlist")
return

move_out:
    call makedir(outdir||"PKT")
    newline=outdir||"PKT/"get_fn(arg(1))
    Address COMMAND 'Copy 'arg(1) newline
    call delete(arg(1))
return newline

addwork:
site_address=arg(1)
qaz=space(arg(2),1)
parse var qaz file disposition priority .
PutLog('Addwork:'site_address file disposition priority)
if ~datatype(site_address,"MIXED") then do
isftn=1;site_address=make5d(site_address)
end;else do
isftn=0;site=site_address
end
if site_address=0 then return
if file="" | ~(exists(file)) then do
    PutLog('Cannot find ['file']')
    return 1
end
file=upper(file)
select
    when disposition="D" then flags=XQ_DELETE
    when disposition="T" then flags=XQ_TRUNCATE
    when disposition="L" then flags=XQ_NOTHING
    otherwise flags=XQ_NOTHING
end
if datatype(priority,"MIXED") then do
    priority=value("DTPRI_"priority)
    prispec=1
end;else do
    prispec=0
    select
    when priority > 50 then nop
    when priority > 30 then priority=DTPRI_CRASH
    when priority > 0 then priority=DTPRI_DIRECT
    when priority=0 then priority=DTPRI_NORM
    when priority=-50 then priority=DTPRI_HOLD
    otherwise priority=DTPRI_CRASH
    end
end
if ~isftn then sendas=get_fn(file)
else do
    if right(file,4)=".CUT" | right(file,4)=".DUT" | right(file,4)=".HUT" | right(file,4)=".OUT" then do
        sendas=get_packetname()
        flags=XQ_DELETE
    end
    else if right(file,4)=".PKT" then do
        sendas=get_fn(file)
        flags=XQ_DELETE
        if ~prispec then priority=DTPRI_HXT
    end
    else if right(file,4)=".TIC" then do
        sendas=get_fn(file)
        flags=XQ_DELETE
    end;else do
        parse var file td'.'tz'.'tn'.'tf'.'tp'.'ext .
        if ext ~= "" then call addarcmail
        else do
            parse var file tz'.'tn'.'tf'.'tp'.'ext .
            if ext ~= "" then call addarcmail
            else sendas=get_fn(file)
        end
        drop td tz tn tf tp ext tmpext j
    end
    dd=find_domain(z)
    site=dd||"#"||z||":"||n||"/"||f||"."||p
end
site_address=XfqGetAddress(site)
QUERY.XQ_NAME=file
QUERY.XQ_SITE=site_address
work=NULL
work=XfqFindWork(QUERY)
if work=NULL then do
    PutLog("File "file" not in site queue, adding")
    XfqAddWorkQuick(site,file,sendas,priority,flags)
end;else do
    PutLog("File "file" already queued")
    if work ~=NULL then call XfqUnlockWork(work)
end
/*call XfqDropObject(work)  */
call XfqFlushQueue(site_address)
call XfqDropObject(site_address)
if work ~=NULL then do
    if isftn then call PutLog('Queued 'file' as 'sendas' for 'dd'#'z':'n'/'f'.'p' Pri:'priority 'Dsp:'flags)
    else call PutLog('Queued 'file' as 'sendas' for 'site' Pri:'priority 'Dsp:'flags)
end
call XfqClose()
return

addarcmail:
if u_shelter="ROOF" then myaddress.domain=GetClip('DOMAIN')
else myaddress.domain=GetClip('FTNDOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
tmpext=upper(left(ext,2))
if datatype(right(ext,1),'n') & (tmpext="MO" | tmpext="TU" | tmpext="WE" | tmpext="TH" | tmpext="FR" | tmpext="SA" | tmpext="SU")  then do
sendas=UPPER(d2x(65536+myaddress.net-tn,4)||d2x(65536+myaddress.node-tf,4)||'.'ext)
flags=XQ_DELETE
return 1
end
return 0

dopolls:
    minpri=arg(1)
    if minpri="" | minpri='MINPRI' then minpri=0
    else do
        minpri=value("DTPRI_"minpri)-1
        PutLog('Polling only Priority >'minpri)
    end
    call PutLog('Scheduling Polls')
    sitelist=XfqGetSiteList()
    call XfqWalkSession(sitelist,sitearray)
    if sitearray.numentries=1 then call PutLog("There is 1 site in the queue")
        else call PutLog("There are "sitearray.numentries" sites in the queue")
    do loop = 1 to sitearray.numentries
        MaxPri=XfqMaxSitePri(sitearray.loop)
        addrtags.XQ_Mandatory=511
        addrtags.XQ_Optional=511
        System = upper(XfqPutAddress(sitearray.loop,addrtags))
        if System="BADPASSWORD" then Iterate
        PutLog("Site:"System" Pri:"MaxPri)

        if (MaxPri<-1)|(MaxPri>120) then Iterate

        if System="BADADDRESS" then iterate
        if System~="" then do
            if MaxPri>MinPri then do
                call PutLog('Calling:' System)
                call dial(System)
            end;else do
                call PutLog('Not calling: 'System' Pri:'MaxPri)
            end
        end
    end
    call XfqDropObject(sitelist)
    call XfqClose()
return 0


cleanxq:
    sitelist=XfqGetSiteList()
    call XfqWalkSession(sitelist,sitearray)
    call PutLog("There are "sitearray.numentries" sites in the queue")
    do loop = 1 to sitearray.numentries
        addrtags.XQ_Mandatory = 511 /* XQADDR_ANYTHING */
        addrtags.XQ_Optional = 511  /* XQADDR_ANYTHING */
        System = XfqPutAddress(sitearray.loop,addrtags)
        call XfqWalkQueue(sitearray.loop,thestem)
        call PutLog("There are "thestem.NUMENTRIES" files for "System)
        do i=1 to thestem.NUMENTRIES
            call PutLog("Sending "thestem.i.NAME" as "thestem.i.ASNAME" at priority "thestem.i.PRI)
            if ~EXISTS(thestem.i.NAME) then do
                call PutLog("File "thestem.i.NAME" does not exist")
                FINDIT.XQ_NAME = thestem.i.NAME
                FINDIT.XQ_SITE = sitearray.loop
                work = XfqFindWork(FINDIT)
                if(work=NULL) then call PutLog("Someone got to it before us!")
                else do
                    call XfqRemoveWork(work)
/*                    call XfqDropObject(work)  */
                end
            end
        end
    end
    call XfqDropObject(sitelist)
    call XfqClose()
return thestem.NUMENTRIES

getakey:
    options PROMPT "Hit a key"
    parse pull junk
return

get_packetname:
pktspec="CFG:packet_spec"
if ~open('out',pktspec,'R') then call PutLog("Can't read "pktspec)
else do
    packet_spec=readln('out')
    call close('out')
    drop out
end
tspec=left(date(),2)||compress(time(),":")
if (tspec=packet_spec) then tspec=tspec+1
do while exists(outdir||""||tspec".PKT")
    tspec=tspec+1
end
if ~open('out',pktspec,'W') then call PutLog("Can't write new "pktspec)
else do
    call writeln('out',tspec)
    call close('out')
    drop out
end
return(tspec||".PKT")

get_fn: procedure
if LastPos('/', arg(1)) ~=0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
    else if LastPos(':', arg(1)) ~=0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
        else return arg(1)

find_domain: procedure
dl=GetClip('DOMAINLIST')
dz=FIND(dl,arg(1))
if dz=0 then return GetClip('DOMAIN')
else return strip(word(dl,dz-1))

drop_vars:
drop tonode. flonode. hisaddress. work err line
drop floadr site site_address i file pktname floname sendas flags disposition priority
return 0

GetVariables: procedure expose envpath u_shelter
/* copy ENV variables to Clips */
say "Loading environment"
mv.1="SCREEN        1"
mv.2="LOGFILE       0"
if u_shelter="ROOF" then mv.3="DOMAIN        1"
    else mv.3="FTNDOMAIN        1"
mv.4="DOMAINLIST    1"
mv.5="INDIR         1"
mv.6="OUTDIR        1"
mv.7="XFERQ         1"
mv.8="REXXDIR       1"
mv.9="REDIALDELAY   1"
mv.10="BUSYDELAY    1"
mv.11="IGNORENOANSWER   1"
mv.12="CALLWINDOWMIN    1"
mv.13="DOMAINAWARE      1"
mv.14="WSPEC        1"
mv.15="WPOS         0"
mv.16="SSPEC        0"
mv.17="SPOS         0"
mv.18="BOSS         0"
mv.19="LOGWINDOW    0"
mv.20="POLLWIN      1"
mv.21="XPRWIN       0"
mv.22="FLODIR       1"
numclips=22
if (u_shelter="ROOF" | u_shelter="PORTICUS") then do
mv.23="MENUS        1"
mv.24="SYSOPBASE    1"
mv.25="FREQDIR      0"
numclips=25
end

do i=1 to numclips
    if ~SetClip(upper(word(mv.i,1)),ReadVar(word(mv.i,1))) then do
        if strip(word(mv.i,2))=0 then say "Warning: Variable "word(mv.i,1)" is not set"
        else do
            say "Error: Variable "word(mv.i,1)" is not set "envpath GetVar(envpath||word(mv.i,1),"G")
            exit 10
        end
    end
end
call SetClip('DOMAIN',GetClip('FTNDOMAIN'))
liblist.1="rexxsupport.library"
liblist.2="OwnDevUnit.library"
liblist.3="XferQ.library"
liblist.4="xprzedzap.library"
liblist.5="xprfts.library"
liblist.6="wpl.library"
liblist.7="wplemsi.library"
liblist.8="RexxDosSupport.library"
reqdlibs=8
say "Checking for required libraries"
do i=1 to reqdlibs
    parse var liblist.i libname level .
    if ~exists('LIBS:'||libname) then do
        say 'Missing required library LIBS:'libname', please investigate'
        exit 20
    end
end
/* Directories to create*/
dir.1=GetClip('INDIR')
dir.2=GetClip('OUTDIR')
dir.3=GetClip('FREQDIR')
dir.4=GetClip('FLODIR')
dir.5=GetClip('INDIR')||"/NONSECURE"
dir.6=GetClip('INDIR')||"/RESUME"
dir.7=GetClip('INDIR')||"/FTNSORT"
dir.8=GetClip('XFERQ')
dirs=8
if u_shelter="ROOF" | u_shelter="PORTICUS" then do
dir.9=GetClip('INDIR')||"/USERS"
dir.10="LOG:rfsacct"
dir.11="LOG:rfsacct/h"
dir.12="LOG:/FREQIT"
dir.13="CFG:/FREQIT"
dirs=13
end
say "Checking for required directories"
do i=1 to dirs
    call makedir(dir.i)
end

address COMMAND 'Assign XFERQ:' GetClip('XFERQ')
domain=GetClip('DOMAIN')
Address COMMAND "Echo >XFERQ:hostaddr" domain"#"GetClip('HOST.ADDRESS.'domain)
singleinbound=GetClip('DOMAINAWARE')=="TRUE"
dl=GetClip('DOMAINLIST')
indir=GetClip('INDIR')
outdir=GetClip('OUTDIR')
do ftn=1 to words(dl)-1 by 2
    if ~singleinbound then do
        call makedir(indir||'/'||word(dl,ftn))
        call makedir(outdir||'/'||word(dl,ftn))
    end
    vname="HOST.ADDRESS."||upper(word(dl,ftn))
    if ~SetClip(vname,ReadVar(vname)) then do
        say "Error: Variable "vname" is not set"
        exit 10
    end
end
if u_shelter="PORTICUS" then Address REXX GetClip('REXXDIR')"/PRODCFG DO"
return

ReadVar: procedure expose ENVPATH
    if arg(2)="R" then x=GetVar(arg(1),"G")
    else x=GetVar(envpath||arg(1),"G")
return x

lower:
return(bitor(arg(1),'20'x))

PutLog:  procedure expose fgroup u_shelter slave log havewin
if havewin=1 then say arg(1)
if slave="SLAVE" then slave="MGR"
if log=1 then address 'ROOFLOG' 'logline' left(time(),5) 'SMM: 'arg(1)
address 'LOGPROC' 'PutLog 'fgroup time() u_shelter||slave': 'arg(1)
return 0

w_height: procedure expose fontsize
BAR=13 /* TOP BORDER + BOTTOM BORDER */
if fontsize="" then fontheight=8
    else fontheight=fontsize
return ((arg(1)*fontheight)+BAR)

w_width: procedure expose fontsize
BORDER=10 /* LEFT BORDER + RIGHT BORDER */
if fontsize="" then fontwidth=8
   else fontwidth=fontsize
return ((arg(1)*fontwidth)+BORDER)

addslash:
curr=arg(1)
select
when right(curr, 1)=":" then nop
when right(curr, 1)="/" then nop  /* TackOn */
otherwise curr=curr"/"
end
return curr
/* a useful procedure by Walt Sullivan    */
dequote: procedure
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~="" then return unq_thing
return thing


break_c:
break_d:
call callcleanup()
PutLog('User Aborted 'what where)
exit 0
novalue:
call template_oops "Novalue" sigl
syntax:
call template_oops "Syntax(RC=" || RC || ")" sigl RC
failure:
call template_oops "Failure(RC=" || RC || ")" sigl
ioerr:
call template_oops "IOErr(RC=" || RC || ")" sigl
halt:
call template_oops "Halt" sigl
template_oops:
parse arg what badline code
if code~="" then call PutLog("ERROR LINE:"badline errortext(code))
    else call PutLog("ERROR LINE:"badline what)
cleanup:
call XfqClose()
exit(40)

/**/
usage:
say CLS
if shelter="" then do
    Say "No Shelter Mailer available"
    u_shelter="*** NO SHELTER ***"
end
say BOLD||u_shelter" Mailer Manager"||OFF" v"smver
say ITALICS"   Usage: Shelter <command> <options>"OFF
say BOLD"       START"OFF"          - load mailer"
say BOLD"       EXIT"OFF"           - unload mailer"
say BOLD"       RESTART"OFF"        - unload, compile and reload mailer"
if u_shelter="UMBRELLA" then say BOLD"       AUTO"OFF"           - load,convert,call Boss and exit"
else say BOLD"       AUTO"OFF"           - load, convert and call Hub"
say
say BOLD"       ADDWORK"OFF" site fullfilename (disposition) (priority)"
say "                      - add a file to a site queue"
SAY "                        disposition:"
SAY "                        D=delete, T=truncate, L=do nothing (default)"
SAY "                        priority: (-128 to +128)      (default CRASH)"
SAY "                        or HOLD=-50, NORM=0, DIRECT=30, CRASH=50"
say BOLD"       FLOCVT"OFF"         - convert 4d ?LO/?UT files to XferQ"
say BOLD"       CLEAN"OFF"          - remove non-existing files from queue"
say
callusage:
if u_shelter~="UMBRELLA" then do
say BOLD"       CALL"OFF" site (CRASH|NOPICKUP|phonenumber|line) (line)"
say "                      - start a site poll"
say "                        site=[domain#][z:][net/]node[.p]"
say "                        site=uu(sitename) | clock(n) | bbs/fax_(sitename)"
say BOLD"       KILL"OFF" site      - abort a site poll"
say BOLD"       POLL"OFF" (priority) - poll all non-HOLD sites with pending mail"
say "                        priority = NORMAL, DIRECT, CRASH"
end;else do
say BOLD"       CALL"OFF" site (number)"
say "                     - start a site poll"
say BOLD"       KILL"OFF" site"
say "                     - abort a site poll"
say "                        site=[domain#][z:][net/]node[.p]"
end
exit 0
/**/

openpscr:
    pscreen=ReadVar('SCREEN')
    if upper(pscreen)="WORKBENCH SCREEN" then return
    Interpret include('CFG:SCREEN.CFG')
    if SCREENPREFS="" | SCREENPREFS="SCREENPREFS" then do
        Say "Error reading CFG:SCREEN.CFG"
        exit 20
    end
    parse var SCREENPREFS width','height','planes
    colors=2**planes
    parse var SCREENFONT font','fontsize
    modes=translate(SCREENMODES," ",",")
    globals=translate(SCREENGLOBALS," ",",")
    if pos('AUTOCLOSE',globals)>0 & pos('WAIT',GetClip(sspec))=0 then do
        Say "Error: cannot open a non-WAIT window on an AUTOCLOSE screen"
        exit 20
    end;else do
        call SetClip("SSMAUTOCLOSE","TRUE")
    end
    cxx=translate(SCREENCX,' "',",'")
    if index(modes,"L") ~=0 then textoverscan_height=TEXTOVERSCAN_HEIGHT*2
    rgball=""
    do i=0 to colors-1
        if RGB.i="" then leave
        rgball=rgball||d2x(word(RGB.i,1))||d2x(word(RGB.i,2))||d2x(word(RGB.i,3))||','
    end
    rgball=delstr(rgball,lastpos(',',rgball),1)
    if width>640 then t_width=width-TEXTOVERSCAN_WIDTH
        else t_width=0
    if height>230 then t_height=height-TEXTOVERSCAN_HEIGHT
        else t_height=0
    if t_width~=0 | t_height~=0 then sz='SIZE=OSCAN_TXT:0,0,+'t_width',+'t_height' DISPCLIP=OSCAN_TEXT'
        else sz='SIZE='width','height
    if SCREENPEN="" | SCREENPENS="SCREENPENS" then opts= sz 'PLANES='planes 'COLORS='rgball 'MODE='modes 'FONT='font'.'fontsize globals cxx
        else opts= sz 'PLANES='planes 'PENS='SCREENPENS 'COLORS='rgball 'MODE='modes 'FONT='font'.'fontsize globals cxx
    cmd='ScreenManager OPEN "'pscreen'"' opts
    Say 'Executing:'cmd
    address COMMAND cmd
    if RC~=0 then say "Could not open screen:" pscreen
    else call setclip('SMMPSCREEN','TRUE')
return

closepscr:
    if GetClip('SMMAUTOCLOSE')="TRUE" then return
    pscreen=GetClip('SCREEN')
    if upper(pscreen)="WORKBENCH SCREEN" then return
    myscreen=GetClip('SMMPSCREEN')
    if upper(myscreen)~="TRUE" then return
    call SetClip('SMMPSCREEN',"")
    call close('STDIN')
    call close('STDOUT')
    call delay(50)
    address COMMAND 'ScreenManager CLOSE "'pscreen'"'
return

setup:
shelter=arg(1)
u_shelter=upper(shelter)
l_shelter=lower(shelter)
call SetClip('SHELTER',u_shelter)
if u_shelter="ROOF" then envpath=""
else envpath=shelter"/"

callscript="S:"||left(u_shelter,1)||"CALL"
file=l_shelter'file'
fwindow=l_shelter'win'
fgroup=l_shelter'wpl'
window=l_shelter'ss'
wgroup=l_shelter'wplstat'
mport=u_shelter
if (u_shelter="UMBRELLA" | u_shelter="GAZEBO") then do
    wsrc.1=l_shelter'CFG.wpl'
    wsrc.2=l_shelter'MODEM.wpl'
    wsrc.3=l_shelter'.wpl'
    wscount=3
end;else do
    if ReadVar('MENUS')="FILE" then do
        wsrc.1=l_shelter'CFG.wpl'
        wsrc.2=l_shelter'MODEM.wpl'
        wsrc.3=l_shelter'NOTIFY.wpl'
        wsrc.4=l_shelter'.wpl'
        wscount=4
    end;else do
        wsrc.1=l_shelter'CFG.wpl'
        wsrc.2=l_shelter'MENUS.wpl'
        wsrc.3=l_shelter'MODEM.wpl'
        wsrc.4=l_shelter'NOTIFY.wpl'
        wsrc.5=l_shelter'.wpl'
        wscount=5
    end
end
return

openwin:
wpos=GetClip('WPOS')
if wpos="" | wpos="WPOS" then wpos="0/80/600/40"
wspec=GetClip('WSPEC')
if wspec="" | wspec="WSPEC" then wspec="INACTIVE/AUTO/WAIT"
spos=GetClip('SPOS')
if spos="" | spos="SPOS" then spos="0/80/600/80"
sspec=GetClip('SSPEC')
if sspec="" | sspec="SSPEC" then sspec="INACTIVE/AUTO/WAIT"
if arg(1)="P" then win='CON:'spos'/'u_shelter' Mailer Manager v'smver' [Click to Close]/'sspec'/SCREEN'
else if arg(1)="S" then win='CON:'wpos'/'u_shelter' Mailer Manager v'smver'/'wspec'/SCREEN'
else return
call close('STDOUT')
pscreen=ReadVar('SCREEN')
call open('STDOUT',win||pscreen,'W')
call close('STDIN')
call open('STDIN','*','R')
havewin=1
return

isftn:
    if datatype(arg1,"N") then return 1
    if pos(arg(1),"#")>0 | pos(arg(1),":")>0 | pos(arg(1),"/")>0 then return 1
return 0